***                                                                                                                                                                                                                                                       
***                                                                                                                                                                                                                                                       
*** This Program already converted to Y2K                                                                                                                                                                                                                 
*** S&T Departement     on 29 April 1999 by Ben.Rahman                                                                                                                                                                                                    
***                                                                                                                                                                                                                                                       
***                                                                                                                                                                                                                                                       
set cent on                                                                                                                                                                                                                                               
*  FILE NAME: PMOD4.PRG                                                                                                                                                                                                                                   
*  BY:                                                                                                                                                                                                                                                    
*  DATE: May 24, 1996                                                                                                                                                                                                                                     
*  DESC: Modification of Cashless Medical Service (CMS-Japanese)                                                                                                                                                                                          
*  CALLED BY:  PMOD0.PRG                                                                                                                                                                                                                                  
*  DATA FILES:                                                                                                                                                                                                                                            
**    Comments by Dickson - 04/01/99                                                                                                                                                                                                                      
**                                                                                                                                                                                                                                                        
** Amended by Dickson - 04/01/99                                                                                                                                                                                                                          
** Split the system date to CCYY, MM & DD for Year 2000 checking                                                                                                                                                                                          
  Set date to British                                                                                                                                                                                                                                     
  Today_DD = VAl(SUBSTR(DTOC(DATE()),1,2))                                                                                                                                                                                                                
  Today_MM = VAL(SUBSTR(DTOC(DATE()),4,2))                                                                                                                                                                                                                
  Today_YY = VAL(SUBSTR(DTOC(DATE()),7,4))                                                                                                                                                                                                                
  IF Today_YY < 10                                                                                                                                                                                                                                        
     Today_CCYY = 2000 + Today_YY                                                                                                                                                                                                                         
  ELSE                                                                                                                                                                                                                                                    
     Today_CCYY = 1900 + Today_YY                                                                                                                                                                                                                         
  ENDIF                                                                                                                                                                                                                                                   
**                                                                                                                                                                                                                                                        
**                                                                                                                                                                                                                                                        
                                                                                                                                                                                                                                                          
** Amended by Dickson - to retrieve the previous CMS date (if any)                                                                                                                                                                                        
sele 5                                                                                                                                                                                                                                                    
SET EXCLU OFF                                                                                                                                                                                                                                             
USE &DR&F5 index &dr&f5                                                                                                                                                                                                                                   
SEEK KODEPAT                                                                                                                                                                                                                                              
IF .not. EOF()                                                                                                                                                                                                                                            
   uINSVAL = pat_insval                                                                                                                                                                                                                                   
else                                                                                                                                                                                                                                                      
   UINSVAL =ctod("  /  /    ")                                                                                                                                                                                                                            
ENDIF                                                                                                                                                                                                                                                     
                                                                                                                                                                                                                                                          
SELECT 1                                                                                                                                                                                                                                                  
**                                                                                                                                                                                                                                                        
store .f. to OKS,okp,PROM                                                                                                                                                                                                                                 
DO WHILE .NOT. OKS .and. lastkey()<>27                                                                                                                                                                                                                    
   HLTH=HEALTHLINE                                                                                                                                                                                                                                        
   PERD=HL_PERIOD                                                                                                                                                                                                                                         
   STRT=HL_START                                                                                                                                                                                                                                          
   END=HL_END                                                                                                                                                                                                                                             
   AKH=HL_END                                                                                                                                                                                                                                             
   DENT=HL_DENT                                                                                                                                                                                                                                           
   MEMB=AEA_MEMBER                                                                                                                                                                                                                                        
   PATNAT=PAT_NATIO                                                                                                                                                                                                                                       
   PATTYP=PAT_CODTYP                                                                                                                                                                                                                                      
   FEE=HL_FEE                                                                                                                                                                                                                                             
   PROG=AEA_PROGR                                                                                                                                                                                                                                         
   ENDA=AEA_ENDATE                                                                                                                                                                                                                                        
   PER=AEASOS_PER                                                                                                                                                                                                                                         
   FAM=AEASOS_FAM                                                                                                                                                                                                                                         
   RELP=FAM_RELPER                                                                                                                                                                                                                                        
   PERC=FAM_PERCOD                                                                                                                                                                                                                                        
   MEDS=MED_SCHEME                                                                                                                                                                                                                                        
   MDAT=MDS_ENDATE                                                                                                                                                                                                                                        
   MNBR=MDS_NBER                                                                                                                                                                                                                                          
   DATFIL=DAT_CRFILE                                                                                                                                                                                                                                      
   ENTDAT=ENTRY_DAT                                                                                                                                                                                                                                       
   SET COLOR TO BG+/B                                                                                                                                                                                                                                     
   @ 10,1 CLEA TO 23,78                                                                                                                                                                                                                                   
   DO BOXT WITH 10,1,"NAME : "+ALLTRIM(PAT_F_NAME)+' '+ALLTRIM(PAT_NAME)+",    CODE : "+PAT_FILCOD+' '+PAT_CODCRP+' '+PAT_CODCRE+' '+PAT_CODDAT+' '+PAT_CODTYP,'BG+','B',.F.,.F.                                                                          
   IF AEAHEAL                                                                                                                                                                                                                                             
      IF HLTH                                                                                                                                                                                                                                             
         DO BOXT WITH 12,1,"HEALTHLINE, Period : "+TRANS(PERD,"##")+", from "+DTOC(STRT)+" to "+DTOC(END),'BG+','B',.F.,.F.                                                                                                                               
         DO BOXT WITH 14,1,"Dental Option : "+TRANS(DENT,"Y")+" (for 12 months subscription).  Fee : "+TRANS(FEE,"###.##"),'BG+','B',.F.,.F.                                                                                                              
      endif                                                                                                                                                                                                                                               
   ENDIF                                                                                                                                                                                                                                                  
   SET COLOR TO BG+/B                                                                                                                                                                                                                                     
   @ 14,1 CLEA TO 23,78                                                                                                                                                                                                                                   
   IF PATNAT<>'ALIEN'                                                                                                                                                                                                                                     
      P10=1                                                                                                                                                                                                                                               
      DO BOX2 WITH 16,3,"Cashless Medical Services :",'YES','NO','gr+','r','gR+','B',P10,.f.,.T.                                                                                                                                                          
      SET COLOR TO BG+/B                                                                                                                                                                                                                                  
      @ 16,1 CLEA TO 23,78                                                                                                                                                                                                                                
      if P10=1                                                                                                                                                                                                                                            
         do boxt with 13,3,"  CASHLESS MEDICAL SERVICES  ",'bg+*','gr',.f.,.T.                                                                                                                                                                            
         instyp=space(15)                                                                                                                                                                                                                                 
         insnam=space(35)                                                                                                                                                                                                                                 
         insval=ctod("  /  /    ")                                                                                                                                                                                                                        
         VADD=0                                                                                                                                                                                                                                           
         SET COLO TO BG+/B,W+/N                                                                                                                                                                                                                           
         DO JAPINS                                                                                                                                                                                                                                        
         IF VADD=2                                                                                                                                                                                                                                        
            CONT='N'                                                                                                                                                                                                                                      
            LOOP                                                                                                                                                                                                                                          
         ENDIF                                                                                                                                                                                                                                            
                                                                                                                                                                                                                                                          
         do boxT with 16,3,"Insurance Name : "+alltrim(insnam),'gr+','r',.F.,.t.                                                                                                                                                                          
         set colo to bg+/b,w+/n                                                                                                                                                                                                                           
         do while insval=ctod("  /  /    ")                                                                                                                                                                                                               
                                                                                                                                                                                                                                                          
** amended by Dickson to display the previous Insurance date                                                                                                                                                                                              
**                                                                                                                                                                                                                                                        
            @ 19,23 SAY 'Previous Validity Date  : '                                                                                                                                                                                                      
            @ 19,50 SAY DTOC(uINSVAL) pict '99/99/9999'                                                                                                                                                                                                   
            @ 20,23 say 'Insurance Validity Date : ' get insval pict '99/99/9999'                                                                                                                                                                         
            @ 21,23 say '                            (DD/MM/YY) '                                                                                                                                                                                         
            read                                                                                                                                                                                                                                          
            lyr=savescreen(0,0,24,79)                                                                                                                                                                                                                     
                                                                                                                                                                                                                                                          
** Amended by Dickson - to handle the Expiry date beyond year 2000                                                                                                                                                                                        
**                                                                                                                                                                                                                                                        
                                                                                                                                                                                                                                                          
            INSVAL_DD = VAL(SUBSTR(dtoc(INSVAL),1,2))                                                                                                                                                                                                     
            INSVAL_MM = VAL(SUBSTR(dtoc(INSVAL),4,2))                                                                                                                                                                                                     
            INSVAL_YY = VAL(SUBSTR(dtoc(INSVAL),7,4))                                                                                                                                                                                                     
            IF INSVAL_YY < 10                                                                                                                                                                                                                             
               INSVAL_CCYY = 2000 + INSVAL_YY                                                                                                                                                                                                             
            ELSE                                                                                                                                                                                                                                          
               INSVAL_CCYY = 1900 + INSVAL_YY                                                                                                                                                                                                             
            ENDIF                                                                                                                                                                                                                                         
                                                                                                                                                                                                                                                          
            CARD_EXPIRED = .T.                                                                                                                                                                                                                            
            IF INSVAL_CCYY < TODAY_CCYY                                                                                                                                                                                                                   
               CARD_EXPIRED = .T.                                                                                                                                                                                                                         
            ELSEIF INSVAL_CCYY > TODAY_CCYY                                                                                                                                                                                                               
               CARD_EXPIRED = .F.                                                                                                                                                                                                                         
                                                                                                                                                                                                                                                          
                      ** same year                                                                                                                                                                                                                        
            ELSE                                                                                                                                                                                                                                          
                                                                                                                                                                                                                                                          
               IF INSVAL_MM < TODAY_MM                                                                                                                                                                                                                    
                  CARD_EXPIRED = .T.                                                                                                                                                                                                                      
               ELSEIF  INSVAL_MM > TODAY_MM                                                                                                                                                                                                               
                  CARD_EXPIRED = .F.                                                                                                                                                                                                                      
                                                                                                                                                                                                                                                          
                      ** same month                                                                                                                                                                                                                       
               ELSE                                                                                                                                                                                                                                       
                  IF  INSVAL_DD < TODAY_DD                                                                                                                                                                                                                
                      CARD_EXPIRED = .T.                                                                                                                                                                                                                  
                  ELSE                                                                                                                                                                                                                                    
                      CARD_EXPIRED = .F.                                                                                                                                                                                                                  
                  ENDIF                                                                                                                                                                                                                                   
               ENDIF                                                                                                                                                                                                                                      
            ENDIF                                                                                                                                                                                                                                         
                                                                                                                                                                                                                                                          
            IF  CARD_EXPIRED = .T.                                                                                                                                                                                                                        
**                                                                                                                                                                                                                                                        
**  End Amendment by Dickson                                                                                                                                                                                                                              
**                                                                                                                                                                                                                                                        
***            IF INSVAL<DATE()                                                                                                                                                                                                                           
               do boxT with 21,25,"Insurance Card Has Already Expired",'gr+','r',.F.,.t.                                                                                                                                                                  
               set cursor off                                                                                                                                                                                                                             
               wait''                                                                                                                                                                                                                                     
               @ 21,25 SAY repl(' ',50)                                                                                                                                                                                                                   
               set cursor on                                                                                                                                                                                                                              
               insval=ctod("  /  /    ")                                                                                                                                                                                                                  
               set colo to bg+/b,w+/n                                                                                                                                                                                                                     
               restscreen(0,0,24,79,lyr)                                                                                                                                                                                                                  
               loop                                                                                                                                                                                                                                       
            endif                                                                                                                                                                                                                                         
         enddo                                                                                                                                                                                                                                            
      endif                                                                                                                                                                                                                                               
      IF LASTKEY()=27                                                                                                                                                                                                                                     
         RETURN                                                                                                                                                                                                                                           
      ENDIF                                                                                                                                                                                                                                               
   ELSE                                                                                                                                                                                                                                                   
      DO BOXT WITH 12,1,'THE PATIENT NATIONALITY IS NOT JAPANESE','BG+','B',.F.,.F.                                                                                                                                                                       
      P10=2                                                                                                                                                                                                                                               
   ENDIF                                                                                                                                                                                                                                                  
                                                                                                                                                                                                                                                          
   IF LASTKEY()=27                                                                                                                                                                                                                                        
      RETURN                                                                                                                                                                                                                                              
   ENDIF                                                                                                                                                                                                                                                  
                                                                                                                                                                                                                                                          
   DO BOX3 WITH 20,3,"DO YOU WANT TO :",'CONFIRM','CANCEL','ESCAPE','GR+','R','W+','N',PL6,.T.,.T.                                                                                                                                                        
                                                                                                                                                                                                                                                          
**    added by Dickson                                                                                                                                                                                                                                    
      SELECT  1                                                                                                                                                                                                                                           
**                                                                                                                                                                                                                                                        
                                                                                                                                                                                                                                                          
   do case                                                                                                                                                                                                                                                
   case PL6=1                                                                                                                                                                                                                                             
      OKs=.t.                                                                                                                                                                                                                                             
   case pl6=2                                                                                                                                                                                                                                             
      store .f. to OKs,prom                                                                                                                                                                                                                               
   case pl6=3 .or. lastkey()=27                                                                                                                                                                                                                           
      return                                                                                                                                                                                                                                              
   endcase                                                                                                                                                                                                                                                
ENDDO                                                                                                                                                                                                                                                     
SELE 1                                                                                                                                                                                                                                                    
IF P10=1                                                                                                                                                                                                                                                  
   DO CMSMOD                                                                                                                                                                                                                                              
ELSE                                                                                                                                                                                                                                                      
   DO CMSDEL                                                                                                                                                                                                                                              
ENDIF                                                                                                                                                                                                                                                     
SELE 1                                                                                                                                                                                                                                                    
RETURN                                                                                                                                                                                                                                                    
*Formatted by: Herman T Ver. 7.1  on May 24, 1996.                                                                                                                                                                                                        
